home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / prog_d / isamexpt.zip / ISBRINST.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-05  |  9KB  |  287 lines
  1. unit Isbrinst;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Grids, Buttons, StdCtrls, ExtCtrls,
  8.   IsamTabl, IsamBrow;
  9.  
  10. type
  11.   TUeberschriftObject = class(TObject)
  12.     Txt: String;
  13.     Idx: Integer;
  14.     Breite: Integer;
  15.     Constructor Init(aTxt: String; aIdx: Integer; aBreite: Integer);
  16.   end;
  17.  
  18.   TBrowserSetupDlg = class(TForm)
  19.     StringGrid1: TStringGrid;
  20.     UpBttn: TSpeedButton;
  21.     DownBttn: TSpeedButton;
  22.     OkBttn: TBitBtn;
  23.     CancelBttn: TBitBtn;
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure UpBttnClick(Sender: TObject);
  26.     procedure DownBttnClick(Sender: TObject);
  27.     procedure FormDestroy(Sender: TObject);
  28.     procedure OkBttnClick(Sender: TObject);
  29.     procedure FormShow(Sender: TObject);
  30.     procedure CancelBttnClick(Sender: TObject);
  31.   private
  32.     SortList: TStringList;
  33.     BrowserName: String;
  34.     IniName    : String;
  35.     Table      : TIsamTable;
  36.   public
  37.     { Public-Deklarationen }
  38.   end;
  39.  
  40. var
  41.   BrowserSetupDlg: TBrowserSetupDlg;
  42.  
  43. Procedure BrowserSetup(aParent: TForm; AppName,BrwName: String;
  44.                        Table: TIsamTable);
  45. Procedure GetArray(AStr: String; var Arr1,Arr2: Integer);
  46.  
  47. implementation
  48.  
  49. Uses IniFiles, UToolDll;
  50.  
  51. {$R *.DFM}
  52.  
  53. Constructor TUeberschriftObject.Init(aTxt: String; aIdx: Integer; aBreite: Integer);
  54. begin
  55.   Txt:= aTxt;
  56.   Idx:= aIdx;
  57.   Breite:= aBreite;
  58. end;
  59.  
  60. procedure TBrowserSetupDlg.FormCreate(Sender: TObject);
  61. var AktDir: String;
  62. begin
  63.   SortList:= TStringList.Create;
  64.   BrowserName:= 'ISAMBROWSER1';
  65.   IniName:= 'ISAMTEST.INI';
  66.   AktDir:= ExtractFilePath(Application.ExeName);
  67.   IniName:= AktDir + ININame;
  68.   if Sprache = 1 then Caption:= 'Browser-Setup';
  69. end;
  70.  
  71. procedure TBrowserSetupDlg.UpBttnClick(Sender: TObject);
  72. var MerkU,MerkB: String;
  73.     MerkS: TUeberschriftObject;
  74. begin
  75.   if StringGrid1.Row = 1 then Messagebeep(0)
  76.   else begin
  77.     MerkU:= StringGrid1.Cells[0,StringGrid1.Row];
  78.     StringGrid1.Cells[0,StringGrid1.Row]:= StringGrid1.Cells[0,StringGrid1.Row-1];
  79.     StringGrid1.Cells[0,StringGrid1.Row-1]:= MerkU;
  80.     MerkB:= StringGrid1.Cells[1,StringGrid1.Row];
  81.     StringGrid1.Cells[1,StringGrid1.Row]:= StringGrid1.Cells[1,StringGrid1.Row-1];
  82.     StringGrid1.Cells[1,StringGrid1.Row-1]:= MerkB;
  83.     MerkS:= TUeberschriftObject(SortList.Objects[StringGrid1.Row-1]);
  84.     SortList.Objects[StringGrid1.Row-1]:= SortList.Objects[StringGrid1.Row-2];
  85.     SortList.Objects[StringGrid1.Row-2]:= MerkS;
  86.     StringGrid1.Row:= StringGrid1.Row-1;
  87.   end;
  88. end;
  89.  
  90. procedure TBrowserSetupDlg.DownBttnClick(Sender: TObject);
  91. var MerkU,MerkB: String;
  92.     MerkS: TUeberschriftObject;
  93. begin
  94.   if StringGrid1.Row = StringGrid1.RowCount-1 then Messagebeep(0)
  95.   else begin
  96.     MerkU:= StringGrid1.Cells[0,StringGrid1.Row];
  97.     StringGrid1.Cells[0,StringGrid1.Row]:= StringGrid1.Cells[0,StringGrid1.Row+1];
  98.     StringGrid1.Cells[0,StringGrid1.Row+1]:= MerkU;
  99.     MerkB:= StringGrid1.Cells[1,StringGrid1.Row];
  100.     StringGrid1.Cells[1,StringGrid1.Row]:= StringGrid1.Cells[1,StringGrid1.Row+1];
  101.     StringGrid1.Cells[1,StringGrid1.Row+1]:= MerkB;
  102.     MerkS:= TUeberschriftObject(SortList.Objects[StringGrid1.Row-1]);
  103.     SortList.Objects[StringGrid1.Row-1]:= SortList.Objects[StringGrid1.Row];
  104.     SortList.Objects[StringGrid1.Row]:= MerkS;
  105.     StringGrid1.Row:= StringGrid1.Row+1;
  106.   end;
  107. end;
  108.  
  109. procedure TBrowserSetupDlg.FormDestroy(Sender: TObject);
  110. begin
  111.   SortList.Free;
  112. end;
  113.  
  114. procedure TBrowserSetupDlg.OkBttnClick(Sender: TObject);
  115. var IniFile: TIniFile;
  116.     i: Integer;
  117.     Ueberschr: TUeberschriftObject;
  118. begin
  119.   IniFile:= TIniFile.Create(ININAME);
  120.   IniFile.EraseSection(BrowserName);
  121.   For i:= 1 to StringGrid1.RowCount-1 do begin
  122.     Ueberschr:= TUeberschriftObject(SortList.Objects[i-1]);
  123.     if Ueberschr <> NIL then begin
  124.       IniFile.WriteString(BrowserName,StringGrid1.Cells[0,i],
  125.                           StringGrid1.Cells[1,i]+','+DezStr(Ueberschr.Idx));
  126.     end;
  127.   end;
  128.   IniFile.Free;
  129.   ModalResult:= mrOk;
  130. end;
  131.  
  132. Procedure GetArray(AStr: String; var Arr1,Arr2: Integer);
  133. var A1Str: String;
  134.     A1,A2,Code: Integer;
  135. begin
  136.   AStr:= UpperCase(AStr);
  137.   Arr1:= 1;
  138.   Arr2:= 1;
  139.   if (Pos('ARRAY[',AStr) > 0) and (Pos('CHAR',Astr) = 0) then begin
  140.     Delete(AStr,1,Pos('ARRAY[',AStr)+5);
  141.     if Pos(']',AStr) > 0 then begin
  142.       AStr:= Copy(AStr,1,Pos(']',AStr)-1);
  143.       if Pos('.',AStr) > 0 then begin
  144.         A1Str:= Copy(AStr,1,Pos('.',AStr)-1);
  145.         While (Pos('.',AStr) > 0) do Delete(AStr,1,Pos('.',AStr));
  146.         Strip(a1Str); Strip(AStr);
  147.         Val(A1Str,A1,Code);
  148.         Val(AStr,A2,Code);
  149.         if (A1 > 0) and (A2 > 0) then begin
  150.           Arr1:= A1;
  151.           Arr2:= A2;
  152.           if Arr1 > Arr2 then begin
  153.             A1:= Arr2;
  154.             Arr2:= Arr1;
  155.             Arr1:= A1;
  156.           end;
  157.         end;
  158.       end;
  159.     end;
  160.   end;
  161. end;
  162.  
  163. procedure TBrowserSetupDlg.FormShow(Sender: TObject);
  164. var IniFile: TIniFile;
  165.     Liste: TStringList;
  166.     Feld,Arr1,Arr2,FNr,Idx,i,Len,Code: Integer;
  167.     X,SStr,FeldName,LenStr: String;
  168. begin
  169.   if (IniName = '') or (BrowserName = '') then begin
  170.     if Sprache = 1 then Errorwindow('Ini-Filename or BrowserName not assigned','')
  171.     else Errorwindow('INI-Dateiname oder Browsername nicht angegeben','');
  172.   end
  173.   else begin
  174.     IniFile:= TIniFile.Create(IniName);
  175.     Liste:= TStringList.Create;
  176.     IniFile.ReadSection(BrowserName,Liste);
  177.     StringGrid1.Cols[0].Clear;
  178.     StringGrid1.Cols[1].Clear;
  179.     if Sprache = 1 then begin
  180.       StringGrid1.Cols[0].Add('Fieldname');
  181.       StringGrid1.Cols[1].Add('Width');
  182.     end
  183.     else begin
  184.       StringGrid1.Cols[0].Add('▄berschrift');
  185.       StringGrid1.Cols[1].Add('Breite');
  186.     end;
  187.     if Liste.Count > 0 then begin
  188.       For i:= 0 to Liste.Count-1 do begin
  189.         X:= IniFile.ReadString(BrowserName,Liste[i],'');
  190.         if Pos(',',X) > 0 then begin
  191.           Val(Copy(X,1,Pos(',',X)-1),Len,Code);
  192.           Delete(X,1,Pos(',',X));
  193.           Val(X,Idx,Code);
  194.         end
  195.         else begin
  196.           Idx:= i+1;
  197.           Val(X,Len,Code);
  198.         end;
  199.         SortList.AddObject(Liste[i],TUeberschriftObject.Init(Liste[i],Idx,Len));
  200.       end;
  201.     end
  202.     else begin
  203.       if Table.IsamRecord.Count > 0 then begin
  204.         FNr:= 0;
  205.         For i:= 0 to Table.IsamRecord.Count-1 do begin
  206.           SStr:= Uppercase(Table.IsamRecord[i]);
  207.           if (Pos('DUMMY',Uppercase(SStr)) = 0) and (Pos('IGNORE',Uppercase(SStr)) = 0) then begin
  208.             Len:= 0;
  209.             if Pos(':',SStr) > 0 then begin
  210.               GetArray(SStr,Arr1,Arr2);
  211.               For Feld:= Arr1 to Arr2 do begin
  212.                 FeldName:= Copy(SStr,1,Pos(':',SStr)-1);
  213.                 Strip(FeldName);
  214.                 if Arr1 <> Arr2 then FeldName:= FeldName + DezStr(Feld);
  215.                 LenStr:= Uppercase(SStr);
  216.                 Delete(LenStr,1,Pos(':',LenStr));
  217.                 Strip(LenStr);
  218.                 if Pos('ARRAY[',LenStr) > 0 then begin
  219.                   Delete(LenStr,1,Pos('ARRAY[',LenStr));
  220.                   Delete(LenStr,1,Pos(']',LenStr));
  221.                 end;
  222.                 if Pos('STRING',LenStr) > 0 then begin
  223.                   if Pos('[',LenStr) > 0 then begin
  224.                     Delete(LenStr,1,Pos('[',LenStr));
  225.                     LenStr:= Copy(LenStr,1,Pos(']',LenStr)-1);
  226.                     Val(LenStr,Len,Code);
  227.                   end
  228.                   else Len:= 255;
  229.                 end
  230.                 else if Pos('INTEGER',LenStr) > 0 then Len:= 8
  231.                 else if Pos('WORD',LenStr) > 0 then Len:= 8
  232.                 else if Pos('BYTE',LenStr) > 0 then Len:= 4
  233.                 else if Pos('LONGINT',LenStr) > 0 then Len:= 10
  234.                 else if Pos('BOOLEAN',LenStr) > 0 then Len:= 4
  235.                 else if Pos('REAL',LenStr) > 0 then Len:= 10;
  236.                 if Len > 0 then begin
  237.                   Inc(FNr);
  238.                   SortList.AddObject(FeldName,TUeberschriftObject.Init(FeldName,FNr,Len));
  239.                 end
  240.                 else Errorwindow(FeldName,LenStr);
  241.               end;
  242.             end;
  243.           end;
  244.         end;
  245.       end;
  246.     end;
  247.     if SortList.Count > 0 then begin
  248.       StringGrid1.RowCount:= SortList.Count+1;
  249.       For i:= 0 to SortList.Count-1 do begin
  250.         with TUeberschriftObject(SortList.Objects[i]) do begin
  251.           StringGrid1.Cols[0].Add(Txt);
  252.           Str(Breite,X);
  253.           StringGrid1.Cols[1].Add(X);
  254.         end;
  255.       end;
  256.     end;
  257.     StringGrid1.Row:= 1;
  258.     Liste.Free;
  259.     IniFile.Free;
  260.   end;
  261. end;
  262.  
  263. procedure TBrowserSetupDlg.CancelBttnClick(Sender: TObject);
  264. begin
  265.   ModalResult:= mrCancel;
  266. end;
  267.  
  268. Procedure BrowserSetup(aParent: TForm; AppName,BrwName: String;
  269.                        Table: TIsamTable);
  270. var AktDir: String;
  271. begin
  272.   AktDir:= ExtractFilePath(Application.ExeName);
  273.   BrowserSetupDlg:= TBrowserSetupDlg.Create(aParent);
  274.   Try
  275.     if Pos('.',AppName) > 0 then AppName:= Copy(AppName,1,Pos('.',AppName)-1);
  276.     While Pos('\',AppName) > 0 do Delete(AppName,1,Pos('\',AppName));
  277.     BrowserSetupDlg.IniName:= AktDir + Appname+'.INI';
  278.     BrowserSetupDlg.Browsername:= BrwName;
  279.     BrowserSetupDlg.Table:= Table;
  280.     BrowserSetupDlg.ShowModal;
  281.   Finally
  282.     BrowserSetupDlg.Free;
  283.   end;
  284. end;
  285.  
  286. end.
  287.